School gardens in urban Hanoi

We model a decision impact pathway is for school gardens as a general intervention for sustainable children’s food environments in urban Hanoi, Vietnam (Whitney et al. 2024).

Conceptual model of school gardens as an intervention. Should urban Hanoi school boards invest time and money in creating school gardens? Should they invest in formal STEM education as part of these gardens?

Urban Hanoi school garden

Simulation of the school garden intervention options:

# Source our model
source("Garden_Model.R")

# Ensure consistent results with the random number generator
# not for each 'run' of the MC simulation but for 
# consistency each time we run the entire simulation 
set.seed(42)

garden_simulation_results <- mcSimulation(
  estimate = estimate_read_csv("data/inputs_school_garden.csv"),
  model_function = school_garden_function,
  numberOfModelRuns = 1e4, #run 10,000 times
  functionSyntax = "plainNames"
)

The Net Present Value (i.e. current value of the future benefits) of the garden decision options over 5 years of the intervention. For public and private schools the STEM costs are considered to be in the same garden space but with the additional costs and benefits of a full STEM education program. All options are compared to the same years of using the land for something that is not related to the garden, i.e. as a playground or for parking. Here we plot the distribution for the decision and frame the projected NPV.

For public schools:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden_public_school_inclusive", 
                                             "NPV_garden_STEM_public_school_inclusive"),
                   old_names = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   new_names = c("NPV public school passive garden", "NPV public school STEM garden"),
                                    method = 'smooth_simple_overlay', 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

For private schools:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
                   old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
                   new_names = c("NPV private school passive garden","NPV private school STEM garden"),
                                    method = 'smooth_simple_overlay', 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

The same results again but this time as boxplots:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                   vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive", "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive", "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   new_names = c("NPV private school passive garden","NPV private school STEM garden", "NPV public school passive garden", "NPV public school STEM garden"),
                                    method = "boxplot", 
                                    base_size = 11, 
                                    x_axis_name = "Comparative NPV outcomes (million VND)")

ggsave("figures/Fig_5_Boxplots.png", width = 15, height = 8, units = "cm")

As boxplots and distributions for public schools:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   old_names = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   new_names = c("NPV public school garden", "NPV public school garden with STEM"),
                                    method = "boxplot_density", 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

As boxplots and distributions for private schools:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
                   old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
                   new_names = c("NPV private school garden","NPV private school with STEM"),
                                    method = "boxplot_density", 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

Summary of results for the decision

Summary of the NPVs for the passive education garden and STEM options for private schools:

summary(garden_simulation_results$y[1:2]) #"NPV_garden_inclusive"                    "NPV_garden_STEM_inclusive"

##  NPV_garden_inclusive NPV_garden_STEM_inclusive
##  Min.   :-1005        Min.   :-3531.5          
##  1st Qu.:  722        1st Qu.:  219.8          
##  Median : 1413        Median :  904.2          
##  Mean   : 1668        Mean   : 1106.9          
##  3rd Qu.: 2327        3rd Qu.: 1783.8          
##  Max.   :11176        Max.   :11145.9

Summary of the NPVs for the passive education garden and STEM options for public schools:

summary(garden_simulation_results$y[3:4]) #"NPV_garden_public_school_inclusive"      "NPV_garden_STEM_public_school_inclusive"

##  NPV_garden_public_school_inclusive NPV_garden_STEM_public_school_inclusive
##  Min.   :-1005.2                    Min.   :-3531.5                        
##  1st Qu.: -221.7                    1st Qu.: -265.3                        
##  Median :  537.1                    Median : -125.1                        
##  Mean   :  910.1                    Mean   :  431.1                        
##  3rd Qu.: 1643.5                    3rd Qu.:  911.7                        
##  Max.   : 8301.3                    Max.   : 7432.2

Summary of the child health outcomes for private and public schools:

summary(garden_simulation_results$y[10:11]) #"health" "health_STEM" 

##      health        health_STEM    
##  Min.   :   0.0   Min.   :   0.0  
##  1st Qu.: 269.9   1st Qu.: 248.3  
##  Median : 688.4   Median : 567.7  
##  Mean   : 749.2   Mean   : 583.6  
##  3rd Qu.:1094.9   3rd Qu.: 859.2  
##  Max.   :5242.5   Max.   :3290.4

Summary of the biodiversity outcomes for the passive education garden and STEM options for private and public schools:

summary(garden_simulation_results$y[9]) #"biodiversity"

##   biodiversity   
##  Min.   : 0.000  
##  1st Qu.: 3.815  
##  Median :10.023  
##  Mean   :10.118  
##  3rd Qu.:15.098  
##  Max.   :55.364

Summary of costs

Total expected costs for a school garden with and without STEM education:

summary(garden_simulation_results$y[12:13])

##   total_costs      total_costs_STEM
##  Min.   :  87.33   Min.   : 143.1  
##  1st Qu.: 199.98   1st Qu.: 357.2  
##  Median : 435.41   Median : 839.6  
##  Mean   : 398.83   Mean   : 929.8  
##  3rd Qu.: 514.87   3rd Qu.:1252.3  
##  Max.   :1474.13   Max.   :5011.9

First year expected costs for a school garden:

summary(garden_simulation_results$y$Cashflow_garden1)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -606.721  -95.383    8.306   65.859  174.797 1869.821

First year expected costs for a school garden with STEM education:

summary(garden_simulation_results$y$Cashflow_garden_STEM1)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -943.72 -237.06 -121.76  -77.60   44.09 1772.05

Cash flows

Cash flow plots of the garden option without formal STEM education. These are the expected returns for public and private schools over the intervention.

# Cashflow of the garden option without formal STEM education
# This will be the cost for public and private schools over the intervention. 

source("functions/plot_cashflow.R")
plot_cashflow_garden <- plot_cashflow(mcSimulation_object = garden_simulation_results, 
              cashflow_var_name = "Cashflow_garden", 
              facet_labels = "Passive garden") + 
  theme(legend.position = "none", axis.title.y = element_blank(),
        axis.title.x = element_blank(), 
  axis.text.x = element_blank(),
  axis.ticks = element_blank())  

# Cashflow of the garden option with formal STEM education
source("functions/plot_cashflow.R")
plot_cashflow_STEM <- plot_cashflow(mcSimulation_object = garden_simulation_results, 
              cashflow_var_name = "Cashflow_garden_STEM", 
              facet_labels = "STEM garden")+
  labs(y = "Cashflow (million VND)") 

# # manually share axis label (not a feature of patchwork)
# 
# ylab <- plot_cashflow_garden$labels$y
# plot_cashflow_garden$labels$y <- plot_cashflow_STEM$labels$y <- " "
# 
# h_patch <- plot_cashflow_garden / plot_cashflow_STEM 
# # Use the tag label as a y-axis label
# wrap_elements(h_patch) +
#   labs(tag = "Cashflow") +
#   theme(
#     plot.tag = element_text(size = rel(1), angle = 90),
#     plot.tag.position = "left"
#   )

plot_cashflow_garden / plot_cashflow_STEM

ggsave("figures/Fig_6_cashflow.png", width=5, height=5) 

Projection to Latent Structures (PLS)

We use Projection to Latent Structures (PLS) model to assess the correlation strength and direction for model variables and outcome variables. The Partial Least Squares is fitted with the orthogonal scores algorithm with pls::plsr.

PLS for private schools:

# For passive education garden option
source("functions/pls_model.R")
pls_result <- pls_model(object = garden_simulation_results,
                resultName = names(garden_simulation_results$y)[1], # the "NPV_garden_inclusive" 
                                ncomp = 1)
# read in the common input table
input_table <- read.csv("data/inputs_school_garden.csv")

label_private_school <- "Private school"

# source the plot function
source("functions/plot_pls.R")

plot_pls_garden <- plot_pls(plsrResults = pls_result, 
                            input_table = input_table, 
                            threshold = 0.9) + 
  theme(legend.position = "none", axis.title.x = element_blank(), 
  axis.text.x = element_blank(),
  axis.ticks = element_blank()) + scale_x_continuous(limits = c(0, 7)) + ggtitle(label_private_school) + 
  annotate(geom="text", x=5, y=1, label="Passive garden")

## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.

#For school garden with formal STEM education
pls_result_STEM <- pls_model(object = garden_simulation_results,
                  resultName = names(garden_simulation_results$y)[2], # the "NPV_garden_STEM" 
                                ncomp = 1)

plot_pls_STEM <- plot_pls(plsrResults = pls_result_STEM, 
                          input_table = input_table, 
                          threshold = 0.9) + 
  scale_x_continuous(limits = c(0, 7)) + 
  annotate(geom="text", x=5, y=1, label="STEM garden")

## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.

plot_pls_garden / plot_pls_STEM 

Interpretation of PLS results for private schools

Garden options for private schools:

source("functions/pls_posthoc.R")
pls_posthoc(plsrResults = pls_result, threshold = 0.9)

## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.362
## y   81.550
## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.362
## y   81.550
## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.362
## y   81.550
## PLS Model Summary:
## Number of Components: 1 
## R-squared Value for Y: 
## % Variance Explained in X: 
## % Variance Explained in Y: 
## 
## Important Variables (VIP > 0.9):
##                                                                    Variable
## if_community_likes                                       if_community_likes
## garden_mental_health_value                       garden_mental_health_value
## child_garden_health_care_savings           child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
##                                             VIP Coefficient
## if_community_likes                    3.5792283    483.3609
## garden_mental_health_value            1.8078520    244.1434
## child_garden_health_care_savings      3.0931584    417.7190
## child_garden_school_performance_value 0.9011608    121.6983
## school_event_value                    6.0637930    818.8917
## school_event_freq                     2.9659178    400.5357

## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
## 
## $r_squared
## NULL
## 
## $explained_variance_x
## NULL
## 
## $explained_variance_y
## NULL
## 
## $important_vars
##                                                                    Variable
## if_community_likes                                       if_community_likes
## garden_mental_health_value                       garden_mental_health_value
## child_garden_health_care_savings           child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
##                                             VIP Coefficient
## if_community_likes                    3.5792283    483.3609
## garden_mental_health_value            1.8078520    244.1434
## child_garden_health_care_savings      3.0931584    417.7190
## child_garden_school_performance_value 0.9011608    121.6983
## school_event_value                    6.0637930    818.8917
## school_event_freq                     2.9659178    400.5357

STEM options for private schools:

pls_posthoc(plsrResults = pls_result_STEM, threshold = 0.9)

## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.364
## y   75.237
## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.364
## y   75.237
## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.364
## y   75.237
## PLS Model Summary:
## Number of Components: 1 
## R-squared Value for Y: 
## % Variance Explained in X: 
## % Variance Explained in Y: 
## 
## Important Variables (VIP > 0.9):
##                                                                    Variable
## if_community_likes                                       if_community_likes
## annual_teacher_training                             annual_teacher_training
## garden_mental_health_value                       garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
##                                            VIP Coefficient
## if_community_likes                    3.623407    486.4791
## annual_teacher_training               2.699158   -362.3893
## garden_mental_health_value            1.776662    238.5348
## child_STEM_community_engagement_value 1.317011    176.8220
## school_event_value                    6.120904    821.7933
## school_event_freq                     2.935882    394.1719

## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
## 
## $r_squared
## NULL
## 
## $explained_variance_x
## NULL
## 
## $explained_variance_y
## NULL
## 
## $important_vars
##                                                                    Variable
## if_community_likes                                       if_community_likes
## annual_teacher_training                             annual_teacher_training
## garden_mental_health_value                       garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
##                                            VIP Coefficient
## if_community_likes                    3.623407    486.4791
## annual_teacher_training               2.699158   -362.3893
## garden_mental_health_value            1.776662    238.5348
## child_STEM_community_engagement_value 1.317011    176.8220
## school_event_value                    6.120904    821.7933
## school_event_freq                     2.935882    394.1719

PLS for public schools:

# For passive education garden option
source("functions/pls_model.R")

pls_result_garden_public <- pls_model(object = garden_simulation_results,
                resultName = names(garden_simulation_results$y)[3], 
                # "NPV_garden_public_school" 
                                ncomp = 1)
# read in the common input table
input_table <- read.csv("data/inputs_school_garden.csv")

label_public_school <- "Public school"

# source the plot function
source("functions/plot_pls.R")
plot_pls_garden_public <- plot_pls(pls_result_garden_public, 
                            input_table = input_table, threshold = 0.9) +
  theme(legend.position = "none", axis.title.x = element_blank(), 
  axis.text.x = element_blank(),
  axis.ticks = element_blank()) + 
  scale_x_continuous(limits = c(0, 7)) + ggtitle(label_public_school) + 
  annotate(geom="text", x=5, y=1, label="Passive garden")

## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.

#For school garden with formal STEM education
pls_result_STEM_public <- pls_model(object = garden_simulation_results,
                  resultName = names(garden_simulation_results$y)[4], 
                  # "NPV_garden_STEM_public_school"
                                ncomp = 1)

plot_pls_public_STEM <- plot_pls(pls_result_STEM_public, 
                                 input_table = input_table, threshold = 0.9) + scale_x_continuous(limits = c(0, 7)) + 
  annotate(geom="text", x=5, y=1, label="STEM garden")

## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.

plot_pls_garden_public / plot_pls_public_STEM 

Interpretation of PLS results for public schools

Garden option in public school:

pls_posthoc(plsrResults = pls_result_garden_public, threshold = 0.9)

## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.371
## y   34.692
## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.371
## y   34.692
## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.371
## y   34.692
## PLS Model Summary:
## Number of Components: 1 
## R-squared Value for Y: 
## % Variance Explained in X: 
## % Variance Explained in Y: 
## 
## Important Variables (VIP > 0.9):
##                                                          Variable      VIP
## if_community_likes                             if_community_likes 3.222189
## garden_mental_health_value             garden_mental_health_value 1.654486
## child_garden_health_care_savings child_garden_health_care_savings 2.670497
## school_event_value                             school_event_value 5.741691
## school_event_freq                               school_event_freq 2.817428
## suitability_of_land_for_garden     suitability_of_land_for_garden 1.797024
## beurocratic_barriers                         beurocratic_barriers 2.488932
##                                  Coefficient
## if_community_likes                  292.2914
## garden_mental_health_value          150.0819
## child_garden_health_care_savings    242.2463
## school_event_value                  520.8408
## school_event_freq                   255.5748
## suitability_of_land_for_garden      163.0118
## beurocratic_barriers               -225.7762

## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
## 
## $r_squared
## NULL
## 
## $explained_variance_x
## NULL
## 
## $explained_variance_y
## NULL
## 
## $important_vars
##                                                          Variable      VIP
## if_community_likes                             if_community_likes 3.222189
## garden_mental_health_value             garden_mental_health_value 1.654486
## child_garden_health_care_savings child_garden_health_care_savings 2.670497
## school_event_value                             school_event_value 5.741691
## school_event_freq                               school_event_freq 2.817428
## suitability_of_land_for_garden     suitability_of_land_for_garden 1.797024
## beurocratic_barriers                         beurocratic_barriers 2.488932
##                                  Coefficient
## if_community_likes                  292.2914
## garden_mental_health_value          150.0819
## child_garden_health_care_savings    242.2463
## school_event_value                  520.8408
## school_event_freq                   255.5748
## suitability_of_land_for_garden      163.0118
## beurocratic_barriers               -225.7762

STEM option in public school:

pls_posthoc(plsrResults = pls_result_STEM_public, threshold = 0.9)

## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.361
## y   45.117
## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.361
## y   45.117
## Data:    X dimension: 10000 75 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.361
## y   45.117
## PLS Model Summary:
## Number of Components: 1 
## R-squared Value for Y: 
## % Variance Explained in X: 
## % Variance Explained in Y: 
## 
## Important Variables (VIP > 0.9):
##                                                                    Variable
## if_community_likes                                       if_community_likes
## annual_teacher_training                             annual_teacher_training
## garden_mental_health_value                       garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
## suitability_of_land_for_garden               suitability_of_land_for_garden
## beurocratic_barriers                                   beurocratic_barriers
##                                            VIP Coefficient
## if_community_likes                    3.352871   303.19595
## annual_teacher_training               3.323785  -300.56570
## garden_mental_health_value            1.649034   149.12007
## child_STEM_community_engagement_value 1.233191   111.51589
## school_event_value                    5.835963   527.73884
## school_event_freq                     2.776369   251.06362
## suitability_of_land_for_garden        1.000465    90.47077
## beurocratic_barriers                  1.433234  -129.60556

## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
## 
## $r_squared
## NULL
## 
## $explained_variance_x
## NULL
## 
## $explained_variance_y
## NULL
## 
## $important_vars
##                                                                    Variable
## if_community_likes                                       if_community_likes
## annual_teacher_training                             annual_teacher_training
## garden_mental_health_value                       garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
## suitability_of_land_for_garden               suitability_of_land_for_garden
## beurocratic_barriers                                   beurocratic_barriers
##                                            VIP Coefficient
## if_community_likes                    3.352871   303.19595
## annual_teacher_training               3.323785  -300.56570
## garden_mental_health_value            1.649034   149.12007
## child_STEM_community_engagement_value 1.233191   111.51589
## school_event_value                    5.835963   527.73884
## school_event_freq                     2.776369   251.06362
## suitability_of_land_for_garden        1.000465    90.47077
## beurocratic_barriers                  1.433234  -129.60556

Value of Information

Here we assess value of information with the multi_EVPI function. We calculate value of information in the form of Expected Value of Perfect Information (EVPI).

# Subset the outputs from the mcSimulation function (y) by selecting the correct variables be sure to run the multi_EVPI only on the variables that we want. Find them with names(garden_simulation_results$y)
mcSimulation_table <- data.frame(garden_simulation_results$x, 
                                 garden_simulation_results$y[1:4])

# List of NPV variables to move to the last position (calculate 4 EVPIs only)
npvs_to_move <- c("NPV_garden_inclusive", "NPV_garden_STEM_inclusive", 
                  "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive")

# Move NPV variables to the last position
mcSimulation_table <- mcSimulation_table %>% select(-all_of(npvs_to_move), all_of(npvs_to_move))

Calculate EVPI:

source("functions/multi_EVPI_test.R")
# evpi <- multi_EVPI_test(mc = mcSimulation_table, first_out_var = "NPV_garden_inclusive")
# save as a local .csv (takes ~ 15 minutes to run this)
# save(evpi,file="data/data_evpi.Rda")
 load("data/data_evpi.Rda")
# open from saved file (last model run) - it is stable result / takes very long to run 

EVPI for private schools:

#Value of information the garden intervention decision
  source("functions/plot_evpi.R")
#plot_evpi_garden <- plot_evpi(EVPIresults = evpi, 
  #                             decision_vars = "NPV_garden_inclusive", 
  #                             new_names = "Garden",
  #                           input_table = input_table, 
  #                           threshold = 10) +
  # theme(legend.position = "none", axis.title.x = element_blank(), 
  # axis.text.x = element_blank(),
  # axis.ticks = element_blank()) + 
  # scale_x_continuous(limits = c(0, 210)) + ggtitle(label_private_school) 

# Value of information for the garden option with formal STEM education.
# using the results of the same multi_EVPI
# plot_evpi_STEM <- plot_evpi(EVPIresults = evpi, 
#                             decision_vars = "NPV_garden_STEM_inclusive", 
#                             new_names = "STEM garden",
#                             input_table = input_table, 
#                             threshold = 10) + scale_x_continuous(limits = c(0, 210)) 

# plot_evpi_garden / plot_evpi_STEM

EVPI for public schools:

# Value of information for the public school garden option with no formal STEM education.

# using the results of the same multi_EVPI
# plot_evpi_public <- plot_evpi(evpi, decision_vars = "NPV_garden_public_school_inclusive", 
#                             new_names = "Garden", 
#                             input_table = input_table, 
#                             threshold = 10) +
#   theme(legend.position = "none", axis.title.x = element_blank(), 
#   axis.text.x = element_blank(),
#   axis.ticks = element_blank()) + 
#   scale_x_continuous(limits = c(0, 210)) + ggtitle(label_public_school) #210

# Value of information for the public school garden option with formal STEM education.
# using the results of the same multi_EVPI
plot_evpi_public_STEM <- plot_evpi(evpi, decision_vars = "NPV_garden_STEM_public_school_inclusive", 
                            new_names = "STEM garden",
                            input_table = input_table, 
                            threshold = 10) # + 
#  scale_x_continuous(limits = c(0, 210))  #210
plot_evpi_public_STEM

# plot_evpi_public / plot_evpi_public_STEM

Pareto-optimal solutions

Our Pareto-optimal solutions represent the best trade-offs among the objectives of biodiversity, child health, and economic return. By focusing on these Pareto-optimal points, the analysis highlights solutions where improvements in one objective cannot be achieved without some compromise in at least one other.

source("pareto/plot_pareto_scenarios.R")

## 
## Attaching package: 'gridExtra'

## The following object is masked from 'package:dplyr':
## 
##     combine

## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

## Warning in get_plot_component(plot, "guide-box"): Multiple components found;
## returning the first one. To return all, use `return_all = TRUE`.

final_plot

# Save the plot
ggsave("figures/Fig_8_pareto_fronts.png", final_plot, width = 10, height = 8, bg = "white")

Controllable variables included:

estimates = read.csv("data/inputs_school_garden.csv")
estimates = estimates[estimates$variable !="", ]

estimates[estimates$control_status == "controllable", ]

##                 variable lower median upper distribution
## 1        number_of_years   5.0     NA   5.0        const
## 6         size_of_garden   5.0     NA 100.0      posnorm
## 13   if_effective_manage   0.5     NA   0.7    tnorm_0_1
## 17 if_effective_teaching   0.2     NA   0.9    tnorm_0_1
## 18 if_effective_training   0.2     NA   0.8    tnorm_0_1
## 23  if_animals_in_garden   0.2     NA   0.8    tnorm_0_1
## 49 if_school_has_canteen   0.2     NA   0.5    tnorm_0_1
## 85     school_event_freq   3.0     NA  10.0      posnorm
## 88            if_parking   0.1     NA   0.8    tnorm_0_1
##                                                           label control_status
## 1                         Number of years for garden simulation   controllable
## 6                                 Size of school garden in (m2)   controllable
## 13                    Chance of effective garden management (%)   controllable
## 17         Chance of high education quality / effectiveness (%)   controllable
## 18                Chance of effective training for teachers (%)   controllable
## 23 Chance of school choosing to integrate animals in garden (%)   controllable
## 49                     Chance that the school has a canteen (%)   controllable
## 85                 Number of school events per year (days/year)   controllable
## 88 Chance of including parking on the plot without a garden (%)   controllable

Variables that are considered out of the control of the decision maker included:

estimates[estimates$control_status != "controllable", ]

##                                   variable  lower median  upper distribution
## 2                            discount_rate  3.000     NA   8.00      posnorm
## 3                                 CV_value  0.100     NA   0.40    tnorm_0_1
## 4                           inflation_rate  5.000     NA  10.00      posnorm
## 7                    expensive_garden_size 80.000     NA  95.00      posnorm
## 8      cost_increase_expensive_garden_size  1.010     NA   2.50      posnorm
## 10                        if_students_like  0.500     NA   0.80    tnorm_0_1
## 11                         if_parents_like  0.500     NA   0.90    tnorm_0_1
## 12                      if_community_likes  0.100     NA   0.85    tnorm_0_1
## 14                  if_garden_yield_enough  0.300     NA   0.80    tnorm_0_1
## 15                       if_garden_healthy  0.500     NA   0.90    tnorm_0_1
## 16                        if_teachers_like  0.200     NA   0.90    tnorm_0_1
## 19                    if_offer_green_space  0.500     NA   0.90    tnorm_0_1
## 20                     if_reduce_pollution  0.200     NA   0.50    tnorm_0_1
## 21                     if_biophysical_good  0.200     NA   0.80    tnorm_0_1
## 25                          equipment_cost  6.000     NA  20.00      posnorm
## 26                       construction_cost  6.500     NA 130.50      posnorm
## 27                  garden_designing_costs 10.000     NA  15.00      posnorm
## 28                   teacher_training_cost  5.000     NA  20.00      posnorm
## 29                   school_board_planning  6.000     NA  12.00      posnorm
## 30                      teaching_equipment  5.000     NA  10.00      posnorm
## 31                        compost_starting  5.000     NA  10.00      posnorm
## 32                           worm_starting  3.000     NA  10.00      posnorm
## 33           livestock_establishment_costs  5.000     NA  25.00      posnorm
## 34                           fishpond_cost  7.000     NA  10.00      posnorm
## 36            if_family_pays_establishment  0.200     NA   0.50    tnorm_0_1
## 37       establishment_family_portion_paid  0.200     NA   0.80    tnorm_0_1
## 39                       maintaining_labor 25.000     NA  40.00      posnorm
## 40                     teacher_salary_cost 20.000     NA  30.00      posnorm
## 41               teaching_equipment_annual  1.000     NA  40.00      posnorm
## 42                          teaching_tools  2.000     NA  10.00      posnorm
## 43                              seed_costs  5.000     NA  20.00      posnorm
## 44                              fertilizer  1.000     NA   2.00      posnorm
## 45                        plant_protection  2.000     NA   5.00      posnorm
## 46                         livestock_maint  2.000     NA  10.00      posnorm
## 47                 annual_teacher_training  5.000     NA 276.00      posnorm
## 50                         canteen_savings  1.000     NA   5.00      posnorm
## 51                           sale_of_yield 10.000     NA  30.00      posnorm
## 53                extra_cirricular_savings 20.000     NA 100.00      posnorm
## 54                      formal_edu_savings  1.000     NA   3.00      posnorm
## 55                 formal_edu_savings_STEM 20.000     NA 100.00      posnorm
## 57                outside_investment_value  1.000     NA   5.00      posnorm
## 58           outside_investment_value_STEM  1.000     NA   8.00      posnorm
## 60              increased_enrollment_value  0.100     NA   5.00      posnorm
## 61         increased_enrollment_value_STEM 10.000     NA 100.00      posnorm
## 63           child_veg_health_care_savings  0.100     NA   5.00      posnorm
## 64      child_veg_school_performance_value  0.010     NA   0.20      posnorm
## 65    child_veg_community_engagement_value  0.010     NA   0.10      posnorm
## 67              garden_mental_health_value  4.000     NA 300.00      posnorm
## 69        child_garden_health_care_savings  9.000     NA 500.00      posnorm
## 70   child_garden_school_performance_value 21.000     NA 182.00      posnorm
## 71 child_garden_community_engagement_value  3.000     NA   7.00      posnorm
## 73          child_STEM_health_care_savings 20.000     NA  80.00      posnorm
## 74     child_STEM_school_performance_value  2.000     NA 100.00      posnorm
## 75   child_STEM_community_engagement_value 10.000     NA 250.00      posnorm
## 77                   green_space_eco_value  1.000     NA  10.00      posnorm
## 78                  reduce_pollution_value  1.000     NA   3.00      posnorm
## 79     chance_garden_is_fallow_green_space  0.001     NA   0.05    tnorm_0_1
## 80                    fallow_eco_reduction  0.500     NA   0.80    tnorm_0_1
## 81                green_space_health_value  1.000     NA  10.00      posnorm
## 82                 fallow_health_reduction  0.500     NA   0.80    tnorm_0_1
## 84                      school_event_value 10.000     NA 200.00      posnorm
## 87            value_of_non_garden_land_use 20.000     NA  50.00      posnorm
## 89                           parking_value  0.100     NA   3.00      posnorm
## 90            costs_of_non_garden_land_use  1.000     NA   5.00      posnorm
## 92                             land_access  0.600     NA   0.95    tnorm_0_1
## 93          suitability_of_land_for_garden  0.600     NA   0.95    tnorm_0_1
## 94                    beurocratic_barriers  0.010     NA   0.50    tnorm_0_1
##                                                                                  label
## 2                                                                   Discounting factor
## 3                      Coefficient of variation for our school garden intervention (%)
## 4                                                                   Inflation rate (%)
## 7                       Cut off value for where the garden becomes more expensive (m2)
## 8              Percentage more expensive if garden is beyond the expensive_garden_size
## 10                                                    Chance of student engagement (%)
## 11                                       Chance of parents support / effectiveness (%)
## 12                                                     Chance of community support (%)
## 14                                          Chance of sufficient yield from garden (%)
## 15                                              Chance of healthy food from garden (%)
## 16                                                    Chance of teacher engagement (%)
## 19                       Chance of garden having ecologically valuable green space (%)
## 20                                              Chance of garden reducing polution (%)
## 21                               Chance of biophysical not damaging (i.e. weather) (%)
## 25                              Costs of equipment for setting up garden (million VND)
## 26                           Costs of construction for setting up garden (million VND)
## 27                                       Costs of design team consultant (million VND)
## 28                     Costs of training teachers when setting up garden (million VND)
## 29                                            Costs of planning meetings (million VND)
## 30                                                Equipment for teaching (million VND)
## 31                                                      Starting compost (million VND)
## 32                                            Starting worms for compost (million VND)
## 33                                       Starting animals  in the garden (million VND)
## 34                                     Digging a fish pond in the garden (million VND)
## 36                                    Chance that families donate to establishment (%)
## 37                              Portion of establishment costs donated by families (%)
## 39                       Annual Labor cost to maintain school garden  (million VND/yr)
## 40                                    Additional teacher salary costs (million VND/yr)
## 41                  Teaching equipment / manitaining microscopes etc. (million VND/yr)
## 42                                        Teaching tools / paper etc. (million VND/yr)
## 43                                                Seeds and seedlings (million VND/yr)
## 44                               Fertilizer i.e. EM to add to compost (million VND/yr)
## 45                                  Integrated Pest Managemernt (IPM) (million VND/yr)
## 46                                               Mainitaining animals (million VND/yr)
## 47                                      Mainitaining teacher training (million VND/yr)
## 50                                                    Canteen savings (million VND/yr)
## 51                                           Sales of garden products (million VND/yr)
## 53                          Savings from extra-cirriclar activities (million VND/year)
## 54               Savings on formal education costs (no STEM garden) (million VND/year)
## 55                           Savings on STEM formal education costs (million VND/year)
## 57                     Outside investment value (reputation) garden (million VND/year)
## 58                       Outside investment value (reputation) STEM (million VND/year)
## 60          Increased enrollment/tuition income (reputation) garden (million VND/year)
## 61            Increased enrollment/tuition income (reputation) STEM (million VND/year)
## 63                      Healthcare savings (child) access to garden (million VND/year)
## 64                  School performance (children) eating garden veg (million VND/year)
## 65                Community engagement (children) eating garden veg (million VND/year)
## 67 Mental health value of children/others having a garden at school (million VND/year)
## 69                        Healthcare savings (children) with garden (million VND/year)
## 70                  School performance value (children) with garden (million VND/year)
## 71                Community engagement value (children) with garden (million VND/year)
## 73                        Healthcare savings (children) STEM garden (million VND/year)
## 74                  School performance value (children) STEM garden (million VND/year)
## 75                Community engagement value (children) STEM garden (million VND/year)
## 77                                             Value of green space (million VND/year)
## 78                       Value of reduced polution on school garden (million VND/year)
## 79                              Chance that the garden space is fallow green space (%)
## 80                     Proportion of value of fallow greenspace compared to garden (%)
## 81                 Value of non-garden green space for child health (million VND/year)
## 82    Proportion of value of fallow greenspace for child heatlh compared to garden (%)
## 84                           Value of garden related school events (million VND/event)
## 87                      Value of non garden land use, playground etc. (million VND/yr)
## 89                                       Above table value of parking (million VND/yr)
## 90                                        Cost of non garden land use (million VND/yr)
## 92                                        Chance that the school has acess to land (%)
## 93                                  Chance that the land at the school is suitable (%)
## 94                       Chance that beurocratic barriers will inhibit the process (%)
##    control_status
## 2       uncertain
## 3       uncertain
## 4       uncertain
## 7       uncertain
## 8       uncertain
## 10      uncertain
## 11      uncertain
## 12      uncertain
## 14      uncertain
## 15      uncertain
## 16      uncertain
## 19      uncertain
## 20      uncertain
## 21      uncertain
## 25      uncertain
## 26      uncertain
## 27      uncertain
## 28      uncertain
## 29      uncertain
## 30      uncertain
## 31      uncertain
## 32      uncertain
## 33      uncertain
## 34      uncertain
## 36      uncertain
## 37      uncertain
## 39      uncertain
## 40      uncertain
## 41      uncertain
## 42      uncertain
## 43      uncertain
## 44      uncertain
## 45      uncertain
## 46      uncertain
## 47      uncertain
## 50      uncertain
## 51      uncertain
## 53      uncertain
## 54      uncertain
## 55      uncertain
## 57      uncertain
## 58      uncertain
## 60      uncertain
## 61      uncertain
## 63      uncertain
## 64      uncertain
## 65      uncertain
## 67      uncertain
## 69      uncertain
## 70      uncertain
## 71      uncertain
## 73      uncertain
## 74      uncertain
## 75      uncertain
## 77      uncertain
## 78      uncertain
## 79      uncertain
## 80      uncertain
## 81      uncertain
## 82      uncertain
## 84      uncertain
## 87      uncertain
## 89      uncertain
## 90      uncertain
## 92      uncertain
## 93      uncertain
## 94      uncertain

Summarize objective results for the Pareto

An rmoo::summary of the values resulting from the rmoo::nsga2 minimization of a fitness function using non-dominated sorting genetic algorithms - II (NSGA-IIs). Multiobjective evolutionary algorithms with 500 random draws with the decisionSupport::random 200 100 a population size of 200 and 100 iterations (or ‘generations’ maxiter) in rmoo::nsga2.

Load the results of a multi-objective optimization run with load, including the fitness values and population of solutions. Display the optimal results with rmoo::summary. The final result@fitness contains the fitness values for all solutions in the final generation of the optimization. The rmoo:non_dominated_fronts() identifies which solutions are Pareto-optimal. The sweep Filters the rescaled fitness matrix mat to retain only the Pareto-optimal solutions front1_set indices of Pareto-optimal solutions from mat2 that includes only these Pareto-optimal solutions. For example, if mat2 has 200 rows, but front1_set contains 24 indices, set1 will be a 24×3 matrix.

load(file="data/optimization_results/private_nostem_500_200_100.RData")
#  loads the previously saved result object from an .RData file.
rmoo::summary(result) 

## 
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated:  3
## Total iterations:  100
## Population size:  200
## Nondominated points found:  200 (100% of total)
## Crowding distance bounds:  Inf 0
## Mutation Probability:  10%
## Crossover Probability:  80%
## 
## Please install package 'ecr' to calculate IGD and GD.
## 
## Please install package 'emoa' to calculate hypervolume.
## #====================================

mat = result@fitness 
front1_set = rmoo::non_dominated_fronts(result)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set1 = mat2[front1_set, ]

Example of Economic and Biodivesity options with Pareto optimal solutions

# Import from saved .RData (takes a long time to run)
load(file="data/optimization_results/private_stem_500_200_100.RData")
rmoo::summary(result)

## 
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated:  3
## Total iterations:  100
## Population size:  200
## Nondominated points found:  200 (100% of total)
## Crowding distance bounds:  Inf 0
## Mutation Probability:  10%
## Crossover Probability:  80%
## 
## Please install package 'ecr' to calculate IGD and GD.
## 
## Please install package 'emoa' to calculate hypervolume.
## #====================================

mat = result@fitness
front1_set = rmoo::non_dominated_fronts(result)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set2_1 = mat2[front1_set, ]
set2 = set2_1[set2_1[, 1]>0, ]

df_results <- as.data.frame(sweep(-mat, 2, c(100, 1, 100), `*`))
colnames(df_results) <- c("Economic", "Biodiversity", "Health")

df_all_results <- as.data.frame(sweep(-mat, 2, c(100, 1, 100), `*`))
colnames(df_all_results) <- c("Economic", "Biodiversity", "Health")

# Plot all 600 solutions
ggplot(df_all_results, aes(x = Economic, y = Biodiversity)) +
  geom_jitter(alpha = 0.5, color = "grey", width = 0.2, height = 0.2) +  # Plot all points in grey
  geom_point(data = df_results, aes(x = Economic, y = Biodiversity), color = "red") +  # Highlight Pareto points in red
  labs(title = "Economic vs Biodiversity Trade-off", x = "Economic", y = "Biodiversity") +
  theme_minimal()

Plot of all options

load(file="data/optimization_results/public_nostem_500_200_100.RData")
rmoo::summary(result)

## 
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated:  3
## Total iterations:  100
## Population size:  200
## Nondominated points found:  200 (100% of total)
## Crowding distance bounds:  Inf 0
## Mutation Probability:  10%
## Crossover Probability:  80%
## 
## Please install package 'ecr' to calculate IGD and GD.
## 
## Please install package 'emoa' to calculate hypervolume.
## #====================================

mat = result@fitness
front1_set = rmoo::non_dominated_fronts(result)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set3 = mat2[front1_set, ]

load(file="data/optimization_results/public_stem_500_200_100.RData")
rmoo::summary(result)

## 
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated:  3
## Total iterations:  100
## Population size:  200
## Nondominated points found:  200 (100% of total)
## Crowding distance bounds:  Inf 0
## Mutation Probability:  10%
## Crossover Probability:  80%
## 
## Please install package 'ecr' to calculate IGD and GD.
## 
## Please install package 'emoa' to calculate hypervolume.
## #====================================

mat = result@fitness
front1_set = rmoo::non_dominated_fronts(result)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set4 = mat2[front1_set, ]

# Plot Pareto results ####

library(plotly)
library(ggplot2)
library(cowplot)

## 
## Attaching package: 'cowplot'

## The following object is masked from 'package:lubridate':
## 
##     stamp

## The following object is masked from 'package:patchwork':
## 
##     align_plots

## The following object is masked from 'package:gt':
## 
##     as_gtable

pareto_3d_plot <- plot_ly() %>%
  add_trace(x = set1[,1], y = set1[,2], z = set1[,3],
            type = "scatter3d", mode = "markers",
            marker = list(color = 'blue', size = 5),
            name = 'private, no STEM') %>%
  add_trace(x = set2[,1], y = set2[,2], z = set2[,3],
            type = "scatter3d", mode = "markers",
            marker = list(color = 'red', size = 5),
            name = 'private, STEM') %>%
  add_trace(x = set3[,1], y = set3[,2], z = set3[,3],
            type = "scatter3d", mode = "markers",
            marker = list(color = 'green', size = 5),
            name = 'public, no STEM') %>%
  add_trace(x = set4[,1], y = set4[,2], z = set4[,3],
            type = "scatter3d", mode = "markers",
            marker = list(color = 'orange', size = 5),
            name = 'public, STEM') %>%
  layout(scene = list(xaxis = list(title = 'economic'),
                      yaxis = list(title = 'biodiversity'),
                      zaxis = list(title = 'health')))

# pareto_3d_plot

Pareto

Input data for the simulations

Summary

Here we provide a summary of the garden intervention options. We do this with a summary table of the simulation results. We show the percentage of missing values as well as the mean, median and standard deviation (SD) for each output of our model simulations. We use the gt_plt_summary() from {gtExtras} and with options from {svglite}. The table shows the name, the plot overview as well as the number of missing values, the mean, median and the standard deviation of the distribution for all variables that were fed into the model from our input table of uncertainty values.

# Subset the outputs from the mcSimulation function (y) to summarize only on the variables that we want.
# names(garden_simulation_results$x)
mcSimulation_table_x <- data.frame(garden_simulation_results$x[4:7]) #, 21:30, 32:41, 43:70, 73:76)  also of possible interest

 gtExtras::gt_plt_summary(mcSimulation_table_x) 

mcSimulation_table_x
10000 rows x 4 cols
	Column	Plot Overview	Missing	Mean	Median	SD
	inflation_rate		0.0%	7.5	7.5	1.5
	size_of_garden		0.0%	45.7	41.8	29.6
	expensive_garden_size		0.0%	87.4	87.5	4.5
	cost_increase_expensive_garden_size		0.0%	1.8	1.8	0.4

# a summary table with missing, mean, median and sd

The table shows the variable name, the plot overview as well as the number of missing values, the mean, median and the standard deviation of the distribution for variables that calculated in the model.

The full repository can be accessed at https://github.com/CWWhitney/urban_school_gardens